home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / ranlib / setall.f < prev    next >
Text File  |  1996-07-19  |  3KB  |  104 lines
  1.       SUBROUTINE setall(iseed1,iseed2)
  2. C**********************************************************************
  3. C
  4. C      SUBROUTINE SETALL(ISEED1,ISEED2)
  5. C               SET ALL random number generators
  6. C
  7. C     Sets the initial seed of generator 1 to ISEED1 and ISEED2. The
  8. C     initial seeds of the other generators are set accordingly, and
  9. C     all generators states are set to these seeds.
  10. C
  11. C     This is a transcription from Pascal to Fortran of routine
  12. C     Set_Initial_Seed from the paper
  13. C
  14. C     L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
  15. C     with Splitting Facilities." ACM Transactions on Mathematical
  16. C     Software, 17:98-111 (1991)
  17. C
  18. C
  19. C                              Arguments
  20. C
  21. C
  22. C     ISEED1 -> First of two integer seeds
  23. C                                   INTEGER ISEED1
  24. C
  25. C     ISEED2 -> Second of two integer seeds
  26. C                                   INTEGER ISEED1
  27. C
  28. C**********************************************************************
  29. C     .. Parameters ..
  30.       INTEGER numg
  31.       PARAMETER (numg=32)
  32. C     ..
  33. C     .. Scalar Arguments ..
  34.       INTEGER iseed1,iseed2
  35.       LOGICAL qssd
  36. C     ..
  37. C     .. Scalars in Common ..
  38.       INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
  39. C     ..
  40. C     .. Arrays in Common ..
  41.       INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
  42.      +        lg2(numg)
  43.       LOGICAL qanti(numg)
  44. C     ..
  45. C     .. Local Scalars ..
  46.       INTEGER g,ocgn
  47.       LOGICAL qqssd
  48. C     ..
  49. C     .. External Functions ..
  50.       INTEGER mltmod
  51.       LOGICAL qrgnin
  52.       EXTERNAL mltmod,qrgnin
  53. C     ..
  54. C     .. External Subroutines ..
  55.       EXTERNAL getcgn,initgn,inrgcm,setcgn
  56. C     ..
  57. C     .. Common blocks ..
  58.       COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
  59.      +       cg2,qanti
  60. C     ..
  61. C     .. Save statement ..
  62.       SAVE /globe/,qqssd
  63. C     ..
  64. C     .. Data statements ..
  65.       DATA qqssd/.FALSE./
  66. C     ..
  67. C     .. Executable Statements ..
  68. C
  69. C     TELL IGNLGI, THE ACTUAL NUMBER GENERATOR, THAT THIS ROUTINE
  70. C      HAS BEEN CALLED.
  71. C
  72.       qqssd = .TRUE.
  73.       CALL getcgn(ocgn)
  74. C
  75. C     Initialize Common Block if Necessary
  76. C
  77.       IF (.NOT. (qrgnin())) CALL inrgcm()
  78.       ig1(1) = iseed1
  79.       ig2(1) = iseed2
  80.       CALL initgn(-1)
  81.       DO 10,g = 2,numg
  82.           ig1(g) = mltmod(a1vw,ig1(g-1),m1)
  83.           ig2(g) = mltmod(a2vw,ig2(g-1),m2)
  84.           CALL setcgn(g)
  85.           CALL initgn(-1)
  86.    10 CONTINUE
  87.       CALL setcgn(ocgn)
  88.       RETURN
  89.  
  90.       ENTRY rgnqsd(qssd)
  91. C**********************************************************************
  92. C
  93. C     SUBROUTINE RGNQSD
  94. C                    Random Number Generator Query SeeD set?
  95. C
  96. C     Returns (LOGICAL) QSSD as .TRUE. if SETALL has been invoked,
  97. C     otherwise returns .FALSE.
  98. C
  99. C**********************************************************************
  100.       qssd = qqssd
  101.       RETURN
  102.  
  103.       END
  104.